home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / boosters.arc / RWORD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-14  |  1.8 KB  |  67 lines
  1. { ------------------------------
  2.   RWORD returns a string with ST
  3.   replacing word N of S.
  4.   ------------------------------ }
  5. Function RWord  ( S : AnyString;
  6.                   N : Integer;
  7.                  ST : AnyString ) : AnyString;
  8.  
  9. {   A word is any blank-delimited character sequence,
  10.     or a string of non-blanks.  There are 7 words in
  11.     this sentence. }
  12.  
  13. var
  14.    NumWords, start, stop, CurrentAddress, len
  15.              : integer;
  16.    Ts, Ats, Tail
  17.              : AnyString;
  18.    BlankFound
  19.              : Boolean;
  20.  
  21. begin
  22.    if Length(S) = 0 then
  23.       Rword := ''
  24.    else
  25.    begin
  26.       len := Length(S);
  27.       NumWords := 0;
  28.       start := 1;
  29.       stop := len;
  30.       BlankFound := True;
  31.       CurrentAddress := 0;
  32.       repeat
  33.         CurrentAddress := CurrentAddress + 1;
  34.         if BlankFound then
  35.         begin
  36.            if S[CurrentAddress] <> #32 then
  37.            begin
  38.               BlankFound := false;
  39.               NumWords := succ(NumWords);
  40.               if NumWords = N then
  41.                  start := CurrentAddress;
  42.            end;
  43.         end
  44.         else
  45.         if S[CurrentAddress] = #32 then
  46.         begin
  47.            BlankFound := true;
  48.            if NumWords = N then
  49.               stop := CurrentAddress;
  50.         end;
  51.      until (CurrentAddress = len ) or ( stop < len );
  52.      if N > NumWords then
  53.         Rword := S
  54.      else
  55.      begin
  56.         Tail := copy ( S, stop, Length(S)-stop+1 );
  57.         Ts := copy ( S, 1, start-1 );
  58.         Ats := St;
  59.         if (length(Ts) + length(St) + length(Tail)) > 255 then
  60.            Ats := copy ( St, 1, 255 - length(Ts) - length(tail) );
  61.         if S[stop] = #32 then
  62.            Rword := Ts + Ats + Tail
  63.         else
  64.            Rword := Ts + Ats;
  65.      end;
  66.    end;
  67. end { Rword };